1 Descripción del Dataset

El dataset escogido para esta práctica recoge información médica de 541 pacientes. Esta información se ha recogido en diferentes hospitales de Kerala, India. Todos los pacientes son mujeres y la clasificación principal es la determinación de la presencia del Síndrome de Ovario Poliquístico (PCOS en inglés).

Este dataset contiene las siguientes 43 variables: - Sl. No: index number - Patient File No.: patient’s file’s number - PCOS (Y/N): presence or absence of PCOS - Age (yrs): age in years - Weight (Kg): weight in kg - Height(Cm): height in cm - BMI: Body Mass Indice - Blood Group: blood group - Pulse rate(bpm): pulse rate in bpm - RR (breaths/min): Respiratory rate - Hb(g/dl): hemoglobine - Cycle(R/I): menstrual cycle - Cycle length(days): length of menstrual cycle in days - Marraige Status (Yrs): number of marriage years - Pregnant(Y/N): presence or absence of pregnancy - No. of aborptions: number of aborptions - FSH(mIU/mL): level of hormone FSH - LH(mIU/mL): level of hormone LH (luteinizing hormone) - FSH/LH: follicle stimulating hormone - Hip(inch): size of hip - Waist(inch): size of waist - Waist:Hip Ratio: ratio between hip and waist - TSH (mIU/L): level of TSH (thyroid stimulating hormone) - AMH(ng/mL): level of Anti-Müllerian hormone (AMH) - PRL(ng/mL): level or prolactine - Vit D3 (ng/mL): level of vitamin D3 - PRG(ng/mL): level of progesterone - RBS(mg/dl): random blood sugar - Weight gain(Y/N): presence or absence of weight gain - hair growth(Y/N): presence or absence of hair growth - Skin darkening (Y/N): presence or absence of skin darkening - Hair loss(Y/N): presence or absence of hair loss - Pimples(Y/N): presence or absence of pimples - Fast food (Y/N): if the patient has been eating fast food - Reg.Exercise(Y/N): presence or absence of regular exercises - BP _Systolic (mmHg): systolic blood pressure - BP _Diastolic (mmHg): diastolic blood pressure - Follicle No. (L): number of follicles on the left ovary - Follicle No. (R): number of follicles on the right ovary - Avg. F size (L) (mm): average size in mm of the follicles on the left ovary - Avg. F size (R) (mm): average size in mm of the follicles on the right ovary - Endometrium (mm): size of endometrium in mm

1.1 PCOS

El PCOS es un desorden dentro del aparato reproductivo femenino que implica ciclos menstruales infrecuentes, irregulares y prolongados. Muchas veces viene acompañado de exceso de hormonas masculinas. Los ovarios con este síndrome desarrollan pequeñas acumulaciones de líquidos (llamados folículos) y no consiguen liberar regularmente los óvulos.

No existe prueba médica definitiva para la detección del POCS a día de hoy, sin embargo, se suele hacer una exploración física por radiografía para identificar los folículos dentro del ovario así como orientarse mediante las respuestas a una serie de preguntas sobre el ciclo menstrual de la paciente. El tratamiento de este síndrome tampoco elimina los síntomas, sino que, en ocasiones los hace dismunuir. Se suele recomendar un cambio en el estilo de vida y la toma de píldoras anticonceptivas para poder regular los ciclos y hacer desaparecer los síntomas asociados al síndrome (dolor abdominal, acné, desregulación hormonal entre muchos otros que varían de paciente a paciente).

1.2 Objetivo de la práctica

Este síndrome es más común de lo que podría parecer, ya que afecta a 1 de entre 10 mujeres; por lo que sería de gran interés, descubrir tanto las causas como los síntomas que pueden determinar un diagnóstico eficaz para aplicar un tratamiento lo más adecuado posible.

El obejtivo de esta práctica será entonces determinar las características sociodemográficas, pero sobre, todo médicas que determinen la existencia de PCOS; por lo tanto, determinar qué factores ayudan al correcto diagnóstico de este síndrome.

Este objetivo a cumplir es de gran importancia para el sector médico, ya que cuanta más precisión en el diagnóstico de un paciente, mejor y más específico podrá ser el tratamiento además de que contribuirá a la investigación dentro de las posibles causas de la aparición de este síndrome.

2 Limpieza de datos

2.1 Importación del dataset

El primer paso será importar los datos desde el archivo csv descargado del repositorio de datos Kaggle.

df <- read.csv(file='csv/initial_data.csv', sep= ',')
head(df)
##   Sl..No Patient.File.No. PCOS..Y.N. Age..yrs. Weight..Kg. Height.Cm.
## 1      1            10001          0        28        44.6      152.0
## 2      2            10002          0        36        65.0      161.5
## 3      3            10003          1        33        68.8      165.0
## 4      4            10004          0        37        65.0      148.0
## 5      5            10005          0        25        52.0      161.0
## 6      6            10006          0        36        74.1      165.0
##        BMI Blood.Group Pulse.rate.bpm. RR..breaths.min. Hb.g.dl.
## 1 19.30000          15              78               22    10.48
## 2 24.92116          15              74               20    11.70
## 3 25.27089          11              72               18    11.80
## 4 29.67495          13              72               20    12.00
## 5 20.06095          11              72               18    10.00
## 6 27.21763          15              78               28    11.20
##   Cycle.R.I. Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.
## 1          2                  5                     7             0
## 2          2                  5                    11             1
## 3          2                  5                    10             1
## 4          2                  5                     4             0
## 5          2                  5                     1             1
## 6          2                  5                     8             1
##   No..of.aborptions FSH.mIU.mL. LH.mIU.mL.   FSH.LH Hip.inch. Waist.inch.
## 1                 0        7.95       3.68 2.160326        36          30
## 2                 0        6.73       1.09 6.174312        38          32
## 3                 0        5.54       0.88 6.295455        40          36
## 4                 0        8.06       2.36 3.415254        42          36
## 5                 0        3.98       0.90 4.422222        37          30
## 6                 0        3.24       1.07 3.028037        44          38
##   Waist.Hip.Ratio TSH..mIU.L. AMH.ng.mL. PRL.ng.mL. Vit.D3..ng.mL.
## 1       0.8333333        0.68       2.07      45.16           17.1
## 2       0.8421053        3.16       1.53      20.09           61.3
## 3       0.9000000        2.54       6.63      10.52           49.7
## 4       0.8571429       16.41       1.22      36.90           33.4
## 5       0.8108108        3.57       2.26      30.09           43.8
## 6       0.8636364        1.60       6.74      16.18           52.4
##   PRG.ng.mL. RBS.mg.dl. Weight.gain.Y.N. hair.growth.Y.N.
## 1       0.57         92                0                0
## 2       0.97         92                0                0
## 3       0.36         84                0                0
## 4       0.36         76                0                0
## 5       0.38         84                0                0
## 6       0.30         76                1                0
##   Skin.darkening..Y.N. Hair.loss.Y.N. Pimples.Y.N. Fast.food..Y.N.
## 1                    0              0            0               1
## 2                    0              0            0               0
## 3                    0              1            1               1
## 4                    0              0            0               0
## 5                    0              1            0               0
## 6                    0              1            0               0
##   Reg.Exercise.Y.N. BP._Systolic..mmHg. BP._Diastolic..mmHg.
## 1                 0                 110                   80
## 2                 0                 120                   70
## 3                 0                 120                   80
## 4                 0                 120                   70
## 5                 0                 120                   80
## 6                 0                 110                   70
##   Follicle.No...L. Follicle.No...R. Avg..F.size..L...mm.
## 1                3                3                   18
## 2                3                5                   15
## 3               13               15                   18
## 4                2                2                   15
## 5                3                4                   16
## 6                9                6                   16
##   Avg..F.size..R...mm. Endometrium..mm. X
## 1                   18              8.5  
## 2                   14              3.7  
## 3                   20             10.0  
## 4                   14              7.5  
## 5                   14              7.0  
## 6                   20              8.0

2.2 Limpieza de valores nulos o perdidos

En primer lugar, veremos si existen datos perdidos dentro de cada variable.

colSums(is.na(df)|df == '')
##                Sl..No      Patient.File.No.            PCOS..Y.N. 
##                     0                     0                     0 
##             Age..yrs.           Weight..Kg.            Height.Cm. 
##                     0                     0                     0 
##                   BMI           Blood.Group       Pulse.rate.bpm. 
##                     0                     0                     0 
##      RR..breaths.min.              Hb.g.dl.            Cycle.R.I. 
##                     0                     0                     0 
##    Cycle.length.days. Marraige.Status..Yrs.         Pregnant.Y.N. 
##                     0                     1                     0 
##     No..of.aborptions           FSH.mIU.mL.            LH.mIU.mL. 
##                     0                     0                     0 
##                FSH.LH             Hip.inch.           Waist.inch. 
##                     0                     0                     0 
##       Waist.Hip.Ratio           TSH..mIU.L.            AMH.ng.mL. 
##                     0                     0                     0 
##            PRL.ng.mL.        Vit.D3..ng.mL.            PRG.ng.mL. 
##                     0                     0                     0 
##            RBS.mg.dl.      Weight.gain.Y.N.      hair.growth.Y.N. 
##                     0                     0                     0 
##  Skin.darkening..Y.N.        Hair.loss.Y.N.          Pimples.Y.N. 
##                     0                     0                     0 
##       Fast.food..Y.N.     Reg.Exercise.Y.N.   BP._Systolic..mmHg. 
##                     1                     0                     0 
##  BP._Diastolic..mmHg.      Follicle.No...L.      Follicle.No...R. 
##                     0                     0                     0 
##  Avg..F.size..L...mm.  Avg..F.size..R...mm.      Endometrium..mm. 
##                     0                     0                     0 
##                     X 
##                   539

Vemos efectivamente que existen datos perdidos para las variables de años de matrimonio y para la consumición de fast food. En cada caso existe un valor perdido.

En el caso de los años de matrimonio seguiremos la estrategia de reemplazar el valor perdido por la mediana de la muestra; de esta manera, como no sabemos cuántos outliers tiene el dataset para esta variable, evitaremos que la media sea sesgada por esos posibles valores extremos. La mediana nos proporcionará un valor más ajustado a la tendencia central sin verse afectada por esos extremos.

En el caso del fast food, como se trata de una variable dicotómica, no tendría sentido reemplazar el valor por la media ya que la variable no acepta valores con decimales. Es por ello que también seguiremos la estrategia de escoger la mediana como indicador de tendencia central y reemplazaremos el valor perdido por este indicador.

Por otra parte, en la variable final (X) existen 539 valores perdidos de 541. Vemos por inspección visual que la variable está vacía, por lo que procederemos a eliminarla.

# Sustitución de los valores perdidos por la mediana de la muestra.
df$Marraige.Status..Yrs.[is.na(df$Marraige.Status..Yrs.)] <- median(df$Marraige.Status..Yrs., na.rm=TRUE)
df$Fast.food..Y.N.[is.na(df$Fast.food..Y.N.)] <- median(df$Fast.food..Y.N., na.rm=TRUE)
# Recreamos el dataframe eliminando la última columna que corresponde a una columna con datos vacíos.
df <- df[,c(1:42)]

Veamos ahora si todos los datos contienen valores que encajan en cada una de las variables.

str(df)
## 'data.frame':    541 obs. of  42 variables:
##  $ Sl..No               : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Patient.File.No.     : int  10001 10002 10003 10004 10005 10006 10007 10008 10009 10010 ...
##  $ PCOS..Y.N.           : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ Age..yrs.            : int  28 36 33 37 25 36 34 33 32 36 ...
##  $ Weight..Kg.          : num  44.6 65 68.8 65 52 74.1 64 58.5 40 52 ...
##  $ Height.Cm.           : num  152 162 165 148 161 ...
##  $ BMI                  : num  19.3 24.9 25.3 29.7 20.1 ...
##  $ Blood.Group          : int  15 15 11 13 11 15 11 13 11 15 ...
##  $ Pulse.rate.bpm.      : int  78 74 72 72 72 78 72 72 72 80 ...
##  $ RR..breaths.min.     : int  22 20 18 20 18 28 18 20 18 20 ...
##  $ Hb.g.dl.             : num  10.5 11.7 11.8 12 10 ...
##  $ Cycle.R.I.           : int  2 2 2 2 2 2 2 2 2 4 ...
##  $ Cycle.length.days.   : int  5 5 5 5 5 5 5 5 5 2 ...
##  $ Marraige.Status..Yrs.: num  7 11 10 4 1 8 2 13 8 4 ...
##  $ Pregnant.Y.N.        : int  0 1 1 0 1 1 0 1 0 0 ...
##  $ No..of.aborptions    : int  0 0 0 0 0 0 0 2 1 0 ...
##  $ FSH.mIU.mL.          : num  7.95 6.73 5.54 8.06 3.98 3.24 2.85 4.86 3.76 2.8 ...
##  $ LH.mIU.mL.           : num  3.68 1.09 0.88 2.36 0.9 1.07 0.31 3.07 3.02 1.51 ...
##  $ FSH.LH               : num  2.16 6.17 6.3 3.42 4.42 ...
##  $ Hip.inch.            : int  36 38 40 42 37 44 39 44 39 40 ...
##  $ Waist.inch.          : int  30 32 36 36 30 38 33 38 35 38 ...
##  $ Waist.Hip.Ratio      : num  0.833 0.842 0.9 0.857 0.811 ...
##  $ TSH..mIU.L.          : num  0.68 3.16 2.54 16.41 3.57 ...
##  $ AMH.ng.mL.           : Factor w/ 301 levels "0.1","0.16","0.19",..: 125 50 267 42 134 269 173 51 33 55 ...
##  $ PRL.ng.mL.           : num  45.2 20.1 10.5 36.9 30.1 ...
##  $ Vit.D3..ng.mL.       : num  17.1 61.3 49.7 33.4 43.8 52.4 42.7 38 21.8 27.7 ...
##  $ PRG.ng.mL.           : num  0.57 0.97 0.36 0.36 0.38 0.3 0.46 0.26 0.3 0.25 ...
##  $ RBS.mg.dl.           : num  92 92 84 76 84 76 93 91 116 125 ...
##  $ Weight.gain.Y.N.     : int  0 0 0 0 0 1 0 1 0 0 ...
##  $ hair.growth.Y.N.     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Skin.darkening..Y.N. : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Hair.loss.Y.N.       : int  0 0 1 0 1 1 0 0 0 0 ...
##  $ Pimples.Y.N.         : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ Fast.food..Y.N.      : num  1 0 1 0 0 0 0 0 0 0 ...
##  $ Reg.Exercise.Y.N.    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ BP._Systolic..mmHg.  : int  110 120 120 120 120 110 120 120 120 110 ...
##  $ BP._Diastolic..mmHg. : int  80 70 80 70 80 70 80 80 80 80 ...
##  $ Follicle.No...L.     : int  3 3 13 2 3 9 6 7 5 1 ...
##  $ Follicle.No...R.     : int  3 5 15 2 4 6 6 6 7 1 ...
##  $ Avg..F.size..L...mm. : num  18 15 18 15 16 16 15 15 17 14 ...
##  $ Avg..F.size..R...mm. : num  18 14 20 14 14 20 16 18 17 17 ...
##  $ Endometrium..mm.     : num  8.5 3.7 10 7.5 7 8 6.8 7.1 4.2 2.5 ...

Vemos que la variable AMH.ng.mL. está definida como una variable categórica; sin embargo, por lógica, esta variable debería ser numérica puesto que está describiendo el nivel de una hormona en sangre. Además vemos que los primeros valores que se nos muestran son, efectivamente, numéricos.

Observemos esta variable para saber si hay algún dato en string, y cambiar el formato a numérico.

df$AMH.ng.mL. <- as.numeric(as.character(df$AMH.ng.mL.))
## Warning: NAs introducidos por coerción

Puesto que hemos recibido el warning de que se han introducido NAs por coerción, intuimos que hay una valor string introducido para un valor perdido. En este caso, también reemplazaremos este valor nulo por la mediana de la variable.

df$AMH.ng.mL.[is.na(df$AMH.ng.mL.)] <- median(df$AMH.ng.mL., na.rm=TRUE)

2.3 Análisis descriptivo para detectar valores extremos

Los valores extremos, bien que comunes en la vida real, suelen distorsionar las muestras estadísticas si existen en demasía. Por lo que es muy importante detercarlos y tomar una decisión sobre su presencia o eliminación de la muestra.

En primer lugar, mostraremos los histogramas de las variables cuantitativas para observar qué variable sparecen tener más o menos outliers.

2.3.1 Histogramas para las variables cuantitativas

df %>%
  gather(Attributes, value, c(4:7, 9:14, 16:17)) %>%
ggplot(aes(x=value, fill=Attributes)) +
  geom_histogram(colour="black", show.legend=FALSE, bins = 10) +
  facet_wrap(~Attributes, scales="free_x") +
  labs(x="Values", y="Frequency",
       title="Histograms of dimensions",
       subtitle="Histograms") +
  theme_bw()

df %>%
  gather(Attributes, value, c(18:28)) %>%
ggplot(aes(x=value, fill=Attributes)) +
  geom_histogram(colour="black", show.legend=FALSE, bins = 10) +
  facet_wrap(~Attributes, scales="free_x") +
  labs(x="Values", y="Frequency",
       title="Histograms of dimensions",
       subtitle="Histograms") +
  theme_bw()

df %>%
  gather(Attributes, value, c(36:42)) %>%
ggplot(aes(x=value, fill=Attributes)) +
  geom_histogram(colour="black", show.legend=FALSE, bins = 10) +
  facet_wrap(~Attributes, scales="free_x") +
  labs(x="Values", y="Frequency",
       title="Histograms of dimensions",
       subtitle="Histograms") +
  theme_bw()

Veamos ahora, de las variables cuantitativas, las que, por inspección visual nos han parecido tener más outliers y veamos qué decisión debemos tomar al respecto con cada una de las variables.

par(mfrow = c(2,3))
list = list(13, 25, 40, 41, 42)
for (i in list){
  boxplot(df[,i], main = colnames(df)[i], width = 100)
}

En primer lugar, para el número de días del ciclo todos los valores son posibles puesto que los ciclos menstruales varían mucho entre mujeres. En segundo lugar, el nivel de prolactina, vemos que tiene muchos outliers. En este caso, la prolactina es una hormona que varía durante el ciclo menstrual por lo que es normal que exista mucha varianza en los datos. En tercer lugar, el tamaño de los folículos también es normal que varíe, en este caso va de 0 a 30 aproximadamente, por lo que se puede dar el caso de que no existan folículos y que por lo tanto su tamaño sea 0. Lo mismo pasa con el tamaño de los folículos en el ovario derecho. Por último, el endometrio es un tejido que recubre la pared del útero. Pero el tamaño de este tejido varía a lo largo del ciclo; por lo que es normal que hayan valores en los que tengamos 0mm de endometrio o bien 18mm.

Siguiendo este planteamiento, vemos que los valores extremos encontrados no corresponden realmente a valores que haya que eliminar porque tienen congruencia con los datos.

2.3.2 Tablas de frecuencia para las variables cualitativas

Una vez ejecutados los histogramas, veamos por parte de las variables cualitativas (categóricas) si hay algún valor que no esté dentro del rango de los posibles valores de cada variable.

table(df$PCOS..Y.N.)
## 
##   0   1 
## 364 177
table(df$Pregnant.Y.N.)
## 
##   0   1 
## 335 206
table(df$Blood.Group)
## 
##  11  12  13  14  15  16  17  18 
## 108  13 135  16 206  19  42   2
table(df$Weight.gain.Y.N.)
## 
##   0   1 
## 337 204
table(df$hair.growth.Y.N.)
## 
##   0   1 
## 393 148
table(df$Skin.darkening..Y.N.)
## 
##   0   1 
## 375 166
table(df$Hair.loss.Y.N.)
## 
##   0   1 
## 296 245
table(df$Pimples.Y.N.)
## 
##   0   1 
## 276 265
table(df$Fast.food..Y.N.)
## 
##   0   1 
## 262 279
table(df$Reg.Exercise.Y.N.)
## 
##   0   1 
## 407 134

Vemos que todos los booleanos contienen dos valores y que con respecto al tipo de sangre, existen 8 valores, los cuales corresponderían a los 8 grupos sanguíneos existentes.

3 Análisis de datos

3.1 Normalidad

Veamos primero los gráficos Q-Q para ver si las variables siguen o no una disfribución normal.

df_numeric_cols <- df[,c(4:7, 9:14, 16:28, 36:42)]
for (i in 1:ncol(df_numeric_cols)) {
  qqnorm(df_numeric_cols[,i], main = paste("Normal Q-Q Plot for ", colnames(df_numeric_cols)[i]))
  qqline(df_numeric_cols[,i], col= 'green')
}

Comprobemos la normalidad con la prueba de Shapiro-Wilk.

for (i in 1:ncol(df_numeric_cols)){
  print(shapiro.test(df[,i]))
}
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.95473, p-value = 7.895e-12
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.95473, p-value = 7.895e-12
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.59157, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.98573, p-value = 3.826e-05
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.98016, p-value = 1.015e-06
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.98543, p-value = 3.095e-05
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.9894, p-value = 0.0006019
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.8878, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.45999, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.79763, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.95695, p-value = 1.804e-11
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.56641, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.83689, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.92079, p-value = 2.974e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.61554, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.47752, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.023729, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.02723, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.049954, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.9757, p-value = 8.042e-08
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.97797, p-value = 2.82e-07
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.97319, p-value = 2.165e-08
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.41935, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.72435, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.8214, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.047852, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.050935, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.6961, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.61419, p-value < 2.2e-16
## 
## 
##  Shapiro-Wilk normality test
## 
## data:  df[, i]
## W = 0.55725, p-value < 2.2e-16

Vemos gracias a estas dos pruebas estadísticas que ninguna de las variables numéricas está normalizada. Sin embargo, realizaremos la normalización debido a que por el teorema del límite central, se asume que se se pueden normalizar los datos de una muestra superior a 30 registros con valores de media 0 y de desviación estándar 1.

Deberemos refactorizar las variables que no queremos que sean normalizadas (en este caso, las categóricas y los índices de los pacientes y sus informes).

df_norm <- df%>%
  mutate(PCOS..Y.N. = as.factor(PCOS..Y.N.),
         Pregnant.Y.N. = as.factor(Pregnant.Y.N.),
         Weight.gain.Y.N. = as.factor(Weight.gain.Y.N.),
         hair.growth.Y.N. = as.factor(hair.growth.Y.N.),
         Skin.darkening..Y.N. = as.factor(Skin.darkening..Y.N.),
         Hair.loss.Y.N. = as.factor(Hair.loss.Y.N.),
         Pimples.Y.N. = as.factor(Pimples.Y.N.),
         Fast.food..Y.N. = as.factor(Fast.food..Y.N.),
         Reg.Exercise.Y.N. = as.factor(Reg.Exercise.Y.N.),
         Blood.Group = as.factor(Blood.Group),
         Age..yrs. = as.factor(Age..yrs.),
         Patient.File.No. = as.factor(Patient.File.No.),
         Sl..No = as.factor(Sl..No)
)

Una vez refactorizadas las variables, deberemos normalizar solamente las variables numéricas.

df_norm <- df_norm %>%
    mutate_if(is.numeric, scale)

Una vez normalizadas las numéricas, volvemos a transformar todas la variables del dataset a numéricas. De esta manera, tenemos dos tablas finales: una tabla con los datos originales del dataset limpiados; y por otro lado, una talba con los valores de las variables numéricas normalizados.

df_norm[] <- lapply(df_norm, function(x) as.numeric(x))
summary(df_norm)
##      Sl..No    Patient.File.No.   PCOS..Y.N.      Age..yrs.    
##  Min.   :  1   Min.   :  1      Min.   :1.000   Min.   : 1.00  
##  1st Qu.:136   1st Qu.:136      1st Qu.:1.000   1st Qu.: 9.00  
##  Median :271   Median :271      Median :1.000   Median :12.00  
##  Mean   :271   Mean   :271      Mean   :1.327   Mean   :12.43  
##  3rd Qu.:406   3rd Qu.:406      3rd Qu.:2.000   3rd Qu.:16.00  
##  Max.   :541   Max.   :541      Max.   :2.000   Max.   :29.00  
##   Weight..Kg.         Height.Cm.            BMI            Blood.Group   
##  Min.   :-2.59670   Min.   :-3.22942   Min.   :-2.93201   Min.   :1.000  
##  1st Qu.:-0.69251   1st Qu.:-0.74332   1st Qu.:-0.65822   1st Qu.:3.000  
##  Median :-0.05777   Median :-0.08036   Median :-0.01801   Median :4.000  
##  Mean   : 0.00000   Mean   : 0.00000   Mean   : 0.00000   Mean   :3.802  
##  3rd Qu.: 0.48628   3rd Qu.: 0.58260   3rd Qu.: 0.57284   3rd Qu.:5.000  
##  Max.   : 4.38535   Max.   : 3.89741   Max.   : 3.59647   Max.   :8.000  
##  Pulse.rate.bpm.    RR..breaths.min.     Hb.g.dl.         Cycle.R.I.    
##  Min.   :-13.5991   Min.   :-1.9211   Min.   :-3.0684   Min.   :-0.621  
##  1st Qu.: -0.2816   1st Qu.:-0.7367   1st Qu.:-0.7614   1st Qu.:-0.621  
##  Median : -0.2816   Median :-0.7367   Median :-0.1846   Median :-0.621  
##  Mean   :  0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.000  
##  3rd Qu.:  0.1698   3rd Qu.: 0.4477   3rd Qu.: 0.6229   3rd Qu.: 1.596  
##  Max.   :  1.9756   Max.   : 5.1853   Max.   : 4.1988   Max.   : 2.705  
##  Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.  
##  Min.   :-3.31152   Min.   :-1.6001       Min.   :1.000  
##  1st Qu.:-0.63059   1st Qu.:-0.7667       1st Qu.:1.000  
##  Median : 0.03964   Median :-0.1416       Median :1.000  
##  Mean   : 0.00000   Mean   : 0.0000       Mean   :1.381  
##  3rd Qu.: 0.03964   3rd Qu.: 0.4835       3rd Qu.:2.000  
##  Max.   : 4.73127   Max.   : 4.6506       Max.   :2.000  
##  No..of.aborptions  FSH.mIU.mL.         LH.mIU.mL.      
##  Min.   :-0.4164   Min.   :-0.06631   Min.   :-0.07442  
##  1st Qu.:-0.4164   1st Qu.:-0.05208   1st Qu.:-0.06288  
##  Median :-0.4164   Median :-0.04494   Median :-0.04811  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.00000  
##  3rd Qu.:-0.4164   3rd Qu.:-0.03775   3rd Qu.:-0.03219  
##  Max.   : 6.8031   Max.   :23.21146   Max.   :23.20820  
##      FSH.LH           Hip.inch.          Waist.inch.      
##  Min.   :-0.11373   Min.   :-3.022391   Min.   :-2.73598  
##  1st Qu.:-0.09043   1st Qu.:-0.502179   1st Qu.:-0.51184  
##  Median :-0.07803   Median : 0.001863   Median : 0.04419  
##  Mean   : 0.00000   Mean   : 0.000000   Mean   : 0.00000  
##  3rd Qu.:-0.04853   3rd Qu.: 0.505906   3rd Qu.: 0.60023  
##  Max.   :22.50585   Max.   : 2.522075   Max.   : 3.65842  
##  Waist.Hip.Ratio     TSH..mIU.L.        AMH.ng.mL.        PRL.ng.mL.     
##  Min.   :-2.94306   Min.   :-0.7832   Min.   :-0.9394   Min.   :-1.5979  
##  1st Qu.:-0.75016   1st Qu.:-0.3998   1st Qu.:-0.6144   1st Qu.:-0.6547  
##  Median : 0.06135   Median :-0.1921   Median :-0.3268   Median :-0.1604  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.79172   3rd Qu.: 0.1568   3rd Qu.: 0.2177   3rd Qu.: 0.3720  
##  Max.   : 1.88388   Max.   :16.5140   Max.   :10.2743   Max.   : 6.9416  
##  Vit.D3..ng.mL.       PRG.ng.mL.         RBS.mg.dl.       
##  Min.   :-0.14418   Min.   :-0.14806   Min.   :-2.146410  
##  1st Qu.:-0.08410   1st Qu.:-0.09477   1st Qu.:-0.422207  
##  Median :-0.06937   Median :-0.07639   Median : 0.008844  
##  Mean   : 0.00000   Mean   : 0.00000   Mean   : 0.000000  
##  3rd Qu.:-0.04453   3rd Qu.:-0.04226   3rd Qu.: 0.386014  
##  Max.   :17.22886   Max.   :22.15603   Max.   :13.479181  
##  Weight.gain.Y.N. hair.growth.Y.N. Skin.darkening..Y.N. Hair.loss.Y.N. 
##  Min.   :1.000    Min.   :1.000    Min.   :1.000        Min.   :1.000  
##  1st Qu.:1.000    1st Qu.:1.000    1st Qu.:1.000        1st Qu.:1.000  
##  Median :1.000    Median :1.000    Median :1.000        Median :1.000  
##  Mean   :1.377    Mean   :1.274    Mean   :1.307        Mean   :1.453  
##  3rd Qu.:2.000    3rd Qu.:2.000    3rd Qu.:2.000        3rd Qu.:2.000  
##  Max.   :2.000    Max.   :2.000    Max.   :2.000        Max.   :2.000  
##   Pimples.Y.N.  Fast.food..Y.N. Reg.Exercise.Y.N. BP._Systolic..mmHg.
##  Min.   :1.00   Min.   :1.000   Min.   :1.000     Min.   :-13.9022   
##  1st Qu.:1.00   1st Qu.:1.000   1st Qu.:1.000     1st Qu.: -0.6313   
##  Median :1.00   Median :2.000   Median :1.000     Median : -0.6313   
##  Mean   :1.49   Mean   :1.516   Mean   :1.248     Mean   :  0.0000   
##  3rd Qu.:2.00   3rd Qu.:2.000   3rd Qu.:1.000     3rd Qu.:  0.7229   
##  Max.   :2.00   Max.   :2.000   Max.   :2.000     Max.   :  3.4313   
##  BP._Diastolic..mmHg. Follicle.No...L.  Follicle.No...R. 
##  Min.   :-12.3657     Min.   :-1.4493   Min.   :-1.4969  
##  1st Qu.: -1.2429     1st Qu.:-0.7399   1st Qu.:-0.8207  
##  Median :  0.5511     Median :-0.2670   Median :-0.1446  
##  Mean   :  0.0000     Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.:  0.5511     3rd Qu.: 0.6787   3rd Qu.: 0.7570  
##  Max.   :  4.1392     Max.   : 3.7525   Max.   : 3.0108  
##  Avg..F.size..L...mm. Avg..F.size..R...mm. Endometrium..mm.  
##  Min.   :-4.210483    Min.   :-4.6557      Min.   :-3.91428  
##  1st Qu.:-0.565799    1st Qu.:-0.7387      1st Qu.:-0.68160  
##  Median :-0.005079    Median : 0.1652      Median : 0.01112  
##  Mean   : 0.000000    Mean   : 0.0000      Mean   : 0.00000  
##  3rd Qu.: 0.836002    3rd Qu.: 0.7678      3rd Qu.: 0.61148  
##  Max.   : 2.518164    Max.   : 2.5757      Max.   : 4.39834

3.2 PCA: reducción de dimensionalidad

Una vez normalizadas las variables, podemos ejecutar un PCA. Esta prueba es muy útil cuando tratamos con un dataset con muchas variables y queremos realizar una reducción de dimensionalidad. Esta prueba comprueba que haya algún tipo de relación entre las variables que contiene el dataset y elabora una serie de componentes principales que tratan de explicar un tanto por ciento del comportamiento de las variables originales.

# Utilizamos la función prcomp para realizar el PCA. 
df_norm.pca <- prcomp(df_norm[,4:42], center = TRUE,scale. = TRUE)

# Utilizamos la función summary() para explorar las proporciones de variancia de cada componente principal.
summary(df_norm.pca)
## Importance of components:
##                           PC1     PC2     PC3     PC4     PC5     PC6
## Standard deviation     2.0734 1.68005 1.42513 1.38115 1.33461 1.21564
## Proportion of Variance 0.1102 0.07237 0.05208 0.04891 0.04567 0.03789
## Cumulative Proportion  0.1102 0.18260 0.23468 0.28359 0.32926 0.36715
##                            PC7     PC8     PC9   PC10   PC11   PC12
## Standard deviation     1.15711 1.14068 1.13581 1.0889 1.0780 1.0525
## Proportion of Variance 0.03433 0.03336 0.03308 0.0304 0.0298 0.0284
## Cumulative Proportion  0.40148 0.43485 0.46793 0.4983 0.5281 0.5565
##                           PC13    PC14    PC15    PC16    PC17    PC18
## Standard deviation     1.03311 1.01675 1.00257 0.99657 0.98955 0.96571
## Proportion of Variance 0.02737 0.02651 0.02577 0.02547 0.02511 0.02391
## Cumulative Proportion  0.58390 0.61040 0.63618 0.66164 0.68675 0.71066
##                           PC19    PC20   PC21    PC22    PC23    PC24
## Standard deviation     0.95054 0.92889 0.9242 0.90843 0.88120 0.87126
## Proportion of Variance 0.02317 0.02212 0.0219 0.02116 0.01991 0.01946
## Cumulative Proportion  0.73383 0.75595 0.7779 0.79902 0.81893 0.83839
##                           PC25    PC26    PC27    PC28    PC29    PC30
## Standard deviation     0.86439 0.83296 0.81974 0.78302 0.76797 0.75610
## Proportion of Variance 0.01916 0.01779 0.01723 0.01572 0.01512 0.01466
## Cumulative Proportion  0.85755 0.87534 0.89257 0.90829 0.92341 0.93807
##                           PC31    PC32    PC33   PC34   PC35    PC36
## Standard deviation     0.73732 0.70191 0.67615 0.6639 0.5373 0.40362
## Proportion of Variance 0.01394 0.01263 0.01172 0.0113 0.0074 0.00418
## Cumulative Proportion  0.95201 0.96464 0.97637 0.9877 0.9951 0.99925
##                           PC37    PC38    PC39
## Standard deviation     0.16105 0.04887 0.03155
## Proportion of Variance 0.00067 0.00006 0.00003
## Cumulative Proportion  0.99991 0.99997 1.00000

Vemos que, el PCA no ayuda a reducir la dimensionalidad del dataset puesto que el componente principal que explica la mayor proporción de variancia solamente describe un 11%, por lo que no es suficiente para determinar el comportamiento de los datos. De ma misma manera ocurre con los otros componentes ya que el modelo ha obtenido 39 componentes de 39 variables observadas, por lo que no hay ninguna agrupacion posible de componentes que expliquen la variación dentro de los datos.

Por lo tanto, seguiremos utilizando todas las variables iniciales. Veamos a continuación un ejemplo de visualización del análisis de componentes principales.

# remotes::install_github('vqv/ggbiplot')
# https://www.rdocumentation.org/packages/ggbiplot/versions/0.55/topics/ggbiplot 

# Para el plot haremos que los puntos sean transparentes, mostraremos las elipses en función de los grupos.
ggbiplot(df_norm.pca, alpha = 0.1, ellipse=TRUE, groups=df_norm$PCOS..Y.N., obs.scale = 2, var.scale = 2)

Guardemos pues los dos datasets que hemos recogido. Uno normalizado y el otro con los datos originales tratando los valores perdidos.

write.csv(df, file = 'csv/cleaned_data.csv', row.names = FALSE)
write.csv(df_norm, file = 'csv/cleaned_data_norm.csv', row.names = FALSE)

3.3 ¿Qué variables se correlacionan más con la presencia de PCOS?

Para esta primera prueba estadística, deberemos seleccionar las variables que nos interesa relacionar. En este caso todas las variables menos las que determinan los índices (fila y número del informe del paciente). Crearemos la matrix de correlación a partir del dataset y se hará una correlación de Pearson. Se presentará el resultado en un gráfico donde solamente aparecerán las correlaciones significativas que se presentarán en color en función del grado de correlación y su positividad o negatividad.

Para esta prueba cogeremos alpha = 0.05.

cor_matrix <- rcorr(as.matrix(df_norm[,c(3:42)]), type = c("pearson"))
corrplot(cor_matrix$r, method = "number", type="upper", order="original", 
         p.mat = cor_matrix$P, sig.level = 0.05, insig = "blank")

Vemos que las variables que más correlacionan significativamente con la presencia de PCOS son: - número de folículo en el ovario derecho: 0.65 - número de folículos en el ovario izquierdo: 0.6 - oscurecimiento de la piel: 0.48 - crecimiento de pelo: 0.46 - aumento de peso: 0.44

3.4 Modelo de regresión lineal

Realizaremos un modelo de regresión lineal para determinar qué variables influyen más a la hora de tener o no PCOS. Primero, transformaremos la variable que informa de la presencia o la ausencia de PCOS a lógica.

df_norm$PCOS..Y.N.cat <- as.logical(df_norm$PCOS..Y.N.) 

A continuación, definiremos distintos modelos con las variables que hemos visto en el apartado anterior que correlacionaban más con la presencia de PCOS.

# Regresores cuantitativos
num_follicle_r = df_norm$Follicle.No...R.
num_follicle_l = df_norm$Follicle.No...L.
skin_dark = df_norm$Skin.darkening..Y.N.
hair_growth = df_norm$hair.growth.Y.N.
weight_gain = df_norm$Weight.gain.Y.N.

# Variable a predecir
pcos = df_norm$PCOS..Y.N.cat

# Definición de los modelos
model1 <- lm(pcos ~ num_follicle_r + num_follicle_l + skin_dark, data = df_norm)
model2 <- lm(pcos ~ num_follicle_r + num_follicle_l + hair_growth, data = df_norm)
model3 <- lm(pcos ~ skin_dark + hair_growth + weight_gain, data = df_norm)
model4 <- lm(pcos ~ num_follicle_r + num_follicle_l + weight_gain, data = df_norm)
model5 <- lm(pcos ~ num_follicle_r + weight_gain + hair_growth + skin_dark, data = df_norm)

Ahora representaremos los diferentes modelos con una tabla que nos indique el coeficiente de determinación de cada uno. Escogeremos el que mayor coeficiente de determinación obtenga.

# Tabla con los coeficientes de determinación de cada modelo
tabla.coeficientes <- matrix(c(1, summary(model1)$r.squared,
                               2, summary(model2)$r.squared,
                               3, summary(model3)$r.squared,
                               4, summary(model4)$r.squared,
                               5, summary(model5)$r.squared),
                             ncol = 2, byrow = TRUE)
colnames(tabla.coeficientes) <- c("Modelo", "R^2")
tabla.coeficientes
##      Modelo       R^2
## [1,]      1 0.4999570
## [2,]      2 0.4999370
## [3,]      3 0.4999715
## [4,]      4 0.4999495
## [5,]      5 0.5000250

Vemos que el modelo con mayor coeficiente de determinación es el modelo 5, con un 0.57, lo cual no es un coeficiente muy alto, pero lo probaremos a continuación.

Determinamos los valores de las variables presentes en el modelo y probaremos el modelo para saber si una persona con estas características tiene alta probabilidad de obtener o no PCOS.

prediction <- data.frame(num_follicle_r = 12,
                         weight_gain = 0,
                         hair_growth = 1,
                         skin_dark = 0)
# Predecir el precio
predict(model5, prediction)
## 1 
## 1

3.5 Modelo de árbol de clasficación: C50

En este apartado ejecutaremos un modelo de árboles de clasificación (C50) el cual nos ayudará a obtener una serie de reglas que determinarán con qué valores de qué variables existe una alta propabilidad de tener o no PCOS. En primer lugar, debemos factorizar la variable de PCOS ya que esa es la que querremos predecir.

df$PCOS..Y.N. <- factor(df$PCOS..Y.N.,
                        levels = c(1,0),
                        labels = c("Yes", "No")) 

Seleccionamos las variables que nos interesan para el modelo supervisado. Eliminaremos la variable de grupo sanguíneo, puesto que desconocemos la asociación de los número con los grupos sanguíneos

df_supervised <- df[,c(3:7,9:42)]

A continuación, tenemos que determinar cuál será nuestra variable principal (y) según la cual se hará el modelo. Por otro lado, se tendrán que seleccionar las variables X con las que trataremos de determinar el valor de y.

set.seed(666)
y <- df_supervised[,1]    # Nuestra categoría según la cual se hace el modelo es la variable PCOS..Y.N., la primera del dataset.
X <- df_supervised[,2:39] 

Para realizar un modelo supervisado, debemos separar la muestra y obtener un dataset para el entrenamiento (con el que haremos el modelo) y otro de test (con el que testearemos la eficacia del modelo). Para ello debemos mezclar las filas, por si existe algún tipo de orden en el dataset del que disponemos. Normalmente se utilizan dos tercios del dataset original para el entrenamiento y un tercio para la prueba.

indexes = sample(1:nrow(df_supervised), size=floor((2/3)*nrow(df_supervised)))
trainX<-X[indexes,]
trainy<-y[indexes]
testX<-X[-indexes,]
testy<-y[-indexes]

A continuación veremos qué contiene cada dataset y qué proporción de Sí y No tienen tanto el test como el train.

summary(trainX)
##    Age..yrs.      Weight..Kg.      Height.Cm.         BMI       
##  Min.   :20.00   Min.   :31.00   Min.   :137.0   Min.   :12.42  
##  1st Qu.:27.75   1st Qu.:52.00   1st Qu.:152.0   1st Qu.:21.64  
##  Median :31.00   Median :60.00   Median :157.0   Median :24.23  
##  Mean   :31.26   Mean   :59.48   Mean   :156.8   Mean   :24.15  
##  3rd Qu.:35.00   3rd Qu.:65.00   3rd Qu.:161.0   3rd Qu.:26.40  
##  Max.   :48.00   Max.   :91.40   Max.   :180.0   Max.   :38.54  
##  Pulse.rate.bpm. RR..breaths.min.    Hb.g.dl.       Cycle.R.I.   
##  Min.   :13.00   Min.   :16.00    Min.   : 8.50   Min.   :2.000  
##  1st Qu.:72.00   1st Qu.:18.00    1st Qu.:10.50   1st Qu.:2.000  
##  Median :72.00   Median :18.00    Median :11.00   Median :2.000  
##  Mean   :73.17   Mean   :19.26    Mean   :11.16   Mean   :2.564  
##  3rd Qu.:74.00   3rd Qu.:20.00    3rd Qu.:11.70   3rd Qu.:4.000  
##  Max.   :82.00   Max.   :28.00    Max.   :14.80   Max.   :5.000  
##  Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.   
##  Min.   : 0.000     Min.   : 0.000        Min.   :0.0000  
##  1st Qu.: 4.000     1st Qu.: 4.000        1st Qu.:0.0000  
##  Median : 5.000     Median : 7.000        Median :0.0000  
##  Mean   : 4.964     Mean   : 7.378        Mean   :0.3972  
##  3rd Qu.: 5.250     3rd Qu.:10.000        3rd Qu.:1.0000  
##  Max.   :12.000     Max.   :30.000        Max.   :1.0000  
##  No..of.aborptions  FSH.mIU.mL.         LH.mIU.mL.      
##  Min.   :0.0000    Min.   :   0.210   Min.   :   0.032  
##  1st Qu.:0.0000    1st Qu.:   3.292   1st Qu.:   1.020  
##  Median :0.0000    Median :   4.860   Median :   2.340  
##  Mean   :0.2722    Mean   :  19.281   Mean   :   8.366  
##  3rd Qu.:0.0000    3rd Qu.:   6.492   3rd Qu.:   3.712  
##  Max.   :5.0000    Max.   :5052.000   Max.   :2018.000  
##      FSH.LH            Hip.inch.      Waist.inch.    Waist.Hip.Ratio 
##  Min.   :   0.0021   Min.   :26.00   Min.   :24.00   Min.   :0.7556  
##  1st Qu.:   1.3981   1st Qu.:36.00   1st Qu.:32.00   1st Qu.:0.8571  
##  Median :   2.2071   Median :38.00   Median :34.00   Median :0.8938  
##  Mean   :   8.4845   Mean   :37.88   Mean   :33.74   Mean   :0.8917  
##  3rd Qu.:   4.0016   3rd Qu.:40.00   3rd Qu.:36.00   3rd Qu.:0.9286  
##  Max.   :1372.8261   Max.   :48.00   Max.   :46.00   Max.   :0.9773  
##   TSH..mIU.L.       AMH.ng.mL.       PRL.ng.mL.     Vit.D3..ng.mL.   
##  Min.   : 0.040   Min.   : 0.100   Min.   :  0.40   Min.   :   0.00  
##  1st Qu.: 1.460   1st Qu.: 2.007   1st Qu.: 14.78   1st Qu.:  20.98  
##  Median : 2.180   Median : 3.805   Median : 22.40   Median :  25.85  
##  Mean   : 2.920   Mean   : 5.516   Mean   : 25.11   Mean   :  45.15  
##  3rd Qu.: 3.445   3rd Qu.: 6.755   3rd Qu.: 30.77   3rd Qu.:  33.40  
##  Max.   :65.000   Max.   :32.000   Max.   :128.24   Max.   :6014.66  
##    PRG.ng.mL.        RBS.mg.dl.    Weight.gain.Y.N. hair.growth.Y.N.
##  Min.   : 0.0470   Min.   : 60.0   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.: 0.2500   1st Qu.: 92.0   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median : 0.3100   Median :100.0   Median :0.0000   Median :0.0000  
##  Mean   : 0.6325   Mean   : 99.9   Mean   :0.3556   Mean   :0.2639  
##  3rd Qu.: 0.4400   3rd Qu.:107.0   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   :85.0000   Max.   :350.0   Max.   :1.0000   Max.   :1.0000  
##  Skin.darkening..Y.N. Hair.loss.Y.N.    Pimples.Y.N.    Fast.food..Y.N. 
##  Min.   :0.0000       Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000       1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000       Median :0.0000   Median :0.0000   Median :1.0000  
##  Mean   :0.2972       Mean   :0.4194   Mean   :0.4444   Mean   :0.5222  
##  3rd Qu.:1.0000       3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   :1.0000       Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
##  Reg.Exercise.Y.N. BP._Systolic..mmHg. BP._Diastolic..mmHg.
##  Min.   :0.0000    Min.   : 12.0       Min.   :  8.00      
##  1st Qu.:0.0000    1st Qu.:110.0       1st Qu.: 70.00      
##  Median :0.0000    Median :110.0       Median : 80.00      
##  Mean   :0.2556    Mean   :114.6       Mean   : 76.94      
##  3rd Qu.:1.0000    3rd Qu.:120.0       3rd Qu.: 80.00      
##  Max.   :1.0000    Max.   :140.0       Max.   :100.00      
##  Follicle.No...L. Follicle.No...R. Avg..F.size..L...mm.
##  Min.   : 0.000   Min.   : 0.000   Min.   : 0.00       
##  1st Qu.: 3.000   1st Qu.: 3.000   1st Qu.:13.00       
##  Median : 5.000   Median : 6.000   Median :15.00       
##  Mean   : 6.058   Mean   : 6.381   Mean   :15.09       
##  3rd Qu.: 8.000   3rd Qu.:10.000   3rd Qu.:18.00       
##  Max.   :22.000   Max.   :20.000   Max.   :24.00       
##  Avg..F.size..R...mm. Endometrium..mm.
##  Min.   : 0.00        Min.   : 0.00   
##  1st Qu.:13.00        1st Qu.: 7.00   
##  Median :16.00        Median : 8.50   
##  Mean   :15.49        Mean   : 8.56   
##  3rd Qu.:18.00        3rd Qu.:10.00   
##  Max.   :24.00        Max.   :18.00
summary(trainy)
## Yes  No 
## 115 245
summary(testX)
##    Age..yrs.      Weight..Kg.       Height.Cm.         BMI       
##  Min.   :21.00   Min.   : 35.00   Min.   :140.0   Min.   :14.57  
##  1st Qu.:28.00   1st Qu.: 53.00   1st Qu.:152.0   1st Qu.:21.90  
##  Median :32.00   Median : 58.90   Median :155.4   Median :24.24  
##  Mean   :31.78   Mean   : 59.95   Mean   :155.9   Mean   :24.63  
##  3rd Qu.:35.00   3rd Qu.: 65.00   3rd Qu.:160.0   3rd Qu.:27.10  
##  Max.   :47.00   Max.   :108.00   Max.   :173.0   Max.   :38.90  
##  Pulse.rate.bpm. RR..breaths.min.    Hb.g.dl.       Cycle.R.I.   
##  Min.   :70.0    Min.   :16.00    Min.   : 9.40   Min.   :2.000  
##  1st Qu.:72.0    1st Qu.:18.00    1st Qu.:10.50   1st Qu.:2.000  
##  Median :72.0    Median :18.00    Median :11.00   Median :2.000  
##  Mean   :73.4    Mean   :19.21    Mean   :11.17   Mean   :2.552  
##  3rd Qu.:74.0    3rd Qu.:20.00    3rd Qu.:11.80   3rd Qu.:4.000  
##  Max.   :82.0    Max.   :26.00    Max.   :14.20   Max.   :4.000  
##  Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.   
##  Min.   : 2.000     Min.   : 1.000        Min.   :0.0000  
##  1st Qu.: 5.000     1st Qu.: 4.000        1st Qu.:0.0000  
##  Median : 5.000     Median : 7.000        Median :0.0000  
##  Mean   : 4.895     Mean   : 8.279        Mean   :0.3481  
##  3rd Qu.: 5.000     3rd Qu.:11.000        3rd Qu.:1.0000  
##  Max.   :11.000     Max.   :25.000        Max.   :1.0000  
##  No..of.aborptions  FSH.mIU.mL.       LH.mIU.mL.         FSH.LH       
##  Min.   :0.0000    Min.   : 1.000   Min.   : 0.020   Min.   : 0.4353  
##  1st Qu.:0.0000    1st Qu.: 3.400   1st Qu.: 1.020   1st Qu.: 1.4644  
##  Median :0.0000    Median : 4.830   Median : 2.110   Median : 2.1368  
##  Mean   :0.3204    Mean   : 5.295   Mean   : 2.698   Mean   : 3.7629  
##  3rd Qu.:0.0000    3rd Qu.: 6.270   3rd Qu.: 3.570   3rd Qu.: 3.8663  
##  Max.   :4.0000    Max.   :60.370   Max.   :14.240   Max.   :50.0000  
##    Hip.inch.      Waist.inch.    Waist.Hip.Ratio   TSH..mIU.L.    
##  Min.   :26.00   Min.   :24.00   Min.   :0.7619   Min.   : 0.050  
##  1st Qu.:36.00   1st Qu.:32.00   1st Qu.:0.8500   1st Qu.: 1.560  
##  Median :38.00   Median :34.00   Median :0.8974   Median : 2.376  
##  Mean   :38.22   Mean   :34.04   Mean   :0.8923   Mean   : 3.102  
##  3rd Qu.:40.00   3rd Qu.:36.00   3rd Qu.:0.9333   3rd Qu.: 3.720  
##  Max.   :48.00   Max.   :47.00   Max.   :0.9792   Max.   :22.590  
##    AMH.ng.mL.       PRL.ng.mL.    Vit.D3..ng.mL.     PRG.ng.mL.     
##  Min.   : 0.160   Min.   : 1.36   Min.   :   6.5   Min.   : 0.1100  
##  1st Qu.: 2.100   1st Qu.:13.79   1st Qu.:  20.3   1st Qu.: 0.2500  
##  Median : 3.700   Median :20.32   Median :  26.4   Median : 0.3200  
##  Mean   : 5.829   Mean   :22.76   Mean   :  59.4   Mean   : 0.5681  
##  3rd Qu.: 7.250   3rd Qu.:28.08   3rd Qu.:  36.2   3rd Qu.: 0.4800  
##  Max.   :66.000   Max.   :99.93   Max.   :5418.6   Max.   :25.3000  
##    RBS.mg.dl.     Weight.gain.Y.N. hair.growth.Y.N. Skin.darkening..Y.N.
##  Min.   : 70.00   Min.   :0.0000   Min.   :0.0000   Min.   :0.000       
##  1st Qu.: 92.00   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.000       
##  Median : 98.00   Median :0.0000   Median :0.0000   Median :0.000       
##  Mean   : 99.71   Mean   :0.4199   Mean   :0.2928   Mean   :0.326       
##  3rd Qu.:107.00   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.000       
##  Max.   :160.00   Max.   :1.0000   Max.   :1.0000   Max.   :1.000       
##  Hair.loss.Y.N.    Pimples.Y.N.    Fast.food..Y.N.  Reg.Exercise.Y.N.
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.000    
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.000    
##  Median :1.0000   Median :1.0000   Median :1.0000   Median :0.000    
##  Mean   :0.5193   Mean   :0.5801   Mean   :0.5028   Mean   :0.232    
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.000    
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.000    
##  BP._Systolic..mmHg. BP._Diastolic..mmHg. Follicle.No...L.
##  Min.   :100.0       Min.   :60.00        Min.   : 0.000  
##  1st Qu.:110.0       1st Qu.:70.00        1st Qu.: 3.000  
##  Median :110.0       Median :80.00        Median : 5.000  
##  Mean   :114.8       Mean   :76.91        Mean   : 6.271  
##  3rd Qu.:120.0       3rd Qu.:80.00        3rd Qu.: 9.000  
##  Max.   :140.0       Max.   :80.00        Max.   :21.000  
##  Follicle.No...R. Avg..F.size..L...mm. Avg..F.size..R...mm.
##  Min.   : 1.00    Min.   : 0.00        Min.   : 0.17       
##  1st Qu.: 4.00    1st Qu.:13.00        1st Qu.:13.00       
##  Median : 6.00    Median :15.00        Median :16.00       
##  Mean   : 7.16    Mean   :14.87        Mean   :15.37       
##  3rd Qu.:10.00    3rd Qu.:18.00        3rd Qu.:18.00       
##  Max.   :20.00    Max.   :21.00        Max.   :22.00       
##  Endometrium..mm.
##  Min.   : 0.000  
##  1st Qu.: 7.000  
##  Median : 8.400  
##  Mean   : 8.309  
##  3rd Qu.: 9.600  
##  Max.   :15.000
summary(testy)
## Yes  No 
##  62 119

Ejecutamos el modelo en el dataset de entrenamiento y obtenemos las reglas.

modelo <- C50::C5.0(trainX, trainy,rules=TRUE )
summary(modelo)
## 
## Call:
## C5.0.default(x = trainX, y = trainy, rules = TRUE)
## 
## 
## C5.0 [Release 2.07 GPL Edition]      Thu Jan  2 21:17:35 2020
## -------------------------------
## 
## Class specified by attribute `outcome'
## 
## Read 360 cases (39 attributes) from undefined.data
## 
## Rules:
## 
## Rule 1: (58, lift 3.1)
##  Weight.gain.Y.N. > 0
##  Follicle.No...R. > 8
##  ->  class Yes  [0.983]
## 
## Rule 2: (42, lift 3.1)
##  Cycle.R.I. > 2
##  Marraige.Status..Yrs. <= 13
##  Weight.gain.Y.N. > 0
##  Follicle.No...R. > 4
##  ->  class Yes  [0.977]
## 
## Rule 3: (13, lift 2.9)
##  Weight..Kg. > 56
##  Reg.Exercise.Y.N. > 0
##  Follicle.No...R. > 8
##  Follicle.No...R. <= 12
##  ->  class Yes  [0.933]
## 
## Rule 4: (29/2, lift 2.8)
##  Follicle.No...R. > 12
##  ->  class Yes  [0.903]
## 
## Rule 5: (15/1, lift 2.8)
##  LH.mIU.mL. > 4.75
##  hair.growth.Y.N. > 0
##  ->  class Yes  [0.882]
## 
## Rule 6: (73/12, lift 2.6)
##  Follicle.No...L. > 9
##  ->  class Yes  [0.827]
## 
## Rule 7: (20/3, lift 2.6)
##  Marraige.Status..Yrs. <= 3.5
##  hair.growth.Y.N. > 0
##  ->  class Yes  [0.818]
## 
## Rule 8: (75/15, lift 2.5)
##  Cycle.R.I. > 2
##  Follicle.No...R. > 4
##  ->  class Yes  [0.792]
## 
## Rule 9: (103/1, lift 1.4)
##  Weight.gain.Y.N. <= 0
##  hair.growth.Y.N. <= 0
##  Pimples.Y.N. <= 0
##  Reg.Exercise.Y.N. <= 0
##  Follicle.No...R. <= 12
##  ->  class No  [0.981]
## 
## Rule 10: (117/2, lift 1.4)
##  Hip.inch. > 32
##  Weight.gain.Y.N. <= 0
##  hair.growth.Y.N. <= 0
##  Reg.Exercise.Y.N. <= 0
##  Follicle.No...R. <= 12
##  ->  class No  [0.975]
## 
## Rule 11: (161/3, lift 1.4)
##  Cycle.R.I. <= 2
##  hair.growth.Y.N. <= 0
##  Follicle.No...L. <= 9
##  Follicle.No...R. <= 8
##  ->  class No  [0.975]
## 
## Rule 12: (146/3, lift 1.4)
##  Cycle.R.I. <= 2
##  Marraige.Status..Yrs. > 3.5
##  LH.mIU.mL. <= 4.75
##  Follicle.No...L. <= 9
##  Follicle.No...R. <= 8
##  ->  class No  [0.973]
## 
## Rule 13: (28, lift 1.4)
##  Marraige.Status..Yrs. > 13
##  Follicle.No...L. <= 9
##  ->  class No  [0.967]
## 
## Rule 14: (153/5, lift 1.4)
##  Vit.D3..ng.mL. > 21.4
##  hair.growth.Y.N. <= 0
##  Follicle.No...R. <= 8
##  ->  class No  [0.961]
## 
## Rule 15: (140/7, lift 1.4)
##  Follicle.No...R. <= 4
##  ->  class No  [0.944]
## 
## Rule 16: (45/4, lift 1.3)
##  Marraige.Status..Yrs. > 11
##  Weight.gain.Y.N. <= 0
##  ->  class No  [0.894]
## 
## Default class: No
## 
## 
## Evaluation on training data (360 cases):
## 
##          Rules     
##    ----------------
##      No      Errors
## 
##      16   13( 3.6%)   <<
## 
## 
##     (a)   (b)    <-classified as
##    ----  ----
##     105    10    (a): class Yes
##       3   242    (b): class No
## 
## 
##  Attribute usage:
## 
##   95.83% Follicle.No...R.
##   73.06% Follicle.No...L.
##   71.67% Cycle.R.I.
##   67.22% hair.growth.Y.N.
##   62.50% Marraige.Status..Yrs.
##   61.94% Weight.gain.Y.N.
##   44.72% LH.mIU.mL.
##   42.50% Vit.D3..ng.mL.
##   41.39% Reg.Exercise.Y.N.
##   32.50% Hip.inch.
##   28.61% Pimples.Y.N.
##    3.61% Weight..Kg.
## 
## 
## Time: 0.0 secs

Finalmente, obtenemos 16 reglas, y para cada uno obtenemos la validez de la regla así como el procentaje de aportación de las variables más influyentes en el diagnóstico de PCOS. De estas reglas describiremos las que tienen una validez superir al 96%:

Regla 1 => Si la persona ha ganado peso y tiene más de 8 folículos en el ovario derecho, es posible que tenga PCOS (98% de validez).

Regla 2 => si la persona lleva menos de 14 años casada, ha ganado peso, tiene más de 4 folículo en el ovario derecho y su irregularidad en el ciclo es mayor a dos días, entonces es probable que tenga PCOS (validez de 98%).

Regla 3 => Si la persona no ha ganado peso, ni le ha crecido el pelo, ni tiene acné, no hace ejercicio regularmente y tiene menos de 13 folículos en el ovario derecho, tiene baja probabilidad de tener PCOS (validez de 98%).

Regla 4 => Si la cadera de la persona mide más de 32 pulgadas (81 cm), no ha ganado peso, no tiene crecimiento ed pelo, no hace ejercicio regularmente y no tiene más de 12 folículos, tiene baja probabilidad de tener PCOS (validez de 98%).

Regla 5 => Si la persona tiene una desregulación del ciclo menor a dos días, no tiene crecimiento de pelo, tiene menos de 10 folículos en el ovario izquierdo y menos de 9 en el derecho, tiene baja probabilidad de tener PCOS (validez de 98%).

Regla 6 => Si la persona ha estado casada más de 3 años y medio, tiene niveles de LH más bajos que 4.76, y tiene menos de 10 folículos enel ovario izquierdo y menos de 9 en el derecho, tiene baja probabilidad de tener PCOS (validez de 97%).

A continuación se muestra el árbol de clasificación que representa el modelo desarrollado. En él podemos qué valore sde cada variable influyen en la presencia o ausencia de PCOS en cada caso.

modelo <- C50::C5.0(trainX, trainy)
plot(modelo, cex=150)

Ahora verificaremos la precisión del modelo con la muestra de prueba (test)

predicted_model <- predict(modelo, testX, type="class" )
print(sprintf("La precisión del árbol es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))
## [1] "La precisión del árbol es: 86.1878 %"

4 Conclusiones

Durante esta práctica se han aplicado tres métodos estadísticos. Por una parte, una evaluación de los índices de correlación entre las variables de la muestra. De ellas se han podido extraer qué variables influyen más en la presencia o la ausencia de PCOS. La visualización de esta matriz ha sido mediante un gráfico en el cual veíamos solamente los valores de correlación significativos. Por otra parte, se ha realizado un modelo de regresión lineal en el que hemos podido ver de la misma manera, de entre las variables que más se correlacionan con la presencia de PCOS, qué combinación determina de la mejor manera la presencia o la ausencia de PCOS. La visualización de estos modelos ha sido mediante una tabla en la que podíamos ver el coeficiente de deteminación de cada uno de los modelos con una prueba final del modelo con mejor R^2. Por último, se ha realizado un modelo de árbol de clasificación con el paquete C50. En él hemos podido ver qué valores de qué variables determinaban o no la presencia o la ausencia de PCOS. A partir de este modelo hemos podido sacar una serie de reglas, finalmente representadas mediante un árbol de clasificación.

Es cierto que muchos de los valores finales de los modelos, por ejemplo, el análisis de correlación y el modelo de regresión lineal, no han dado resultados muy prometedores en cuanto a la precisión del diagnóstico de PCOS. Para ello, en futuros trabajos sería necesaria tener una muestra más amplia. Además de tener más claridad en las variables ya que muchas de ellas dependen del momento en el que se ha hecho el análisis puesto que pueden variar mucho en función del tiempo: por ejemplo, los niveles hormonales, sobre todo de FSH y LH varían en función del momento del ciclo en el que se encuentre la paciente. Es por eso que, en futuros trabajos, sería interesante obtener varios registros para cada paciente y saber en qué momento del ciclo han sido extraídos, para que los modelos sean más precisos y ajustados a la realidad y las variables médicas habituales.

Lo que no cabe duda es que, el número de folículos influye en el diagnóstico de este síndrome ya que estas variables han sido significativamente representativas de la presencia de PCOS en caso de tener valores elevados; lo cual cuadra con los procedimientos actuales para el diagnóstico del síndrome hoy en día.